home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
nktools.zip
/
DOS4TO5.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-06-18
|
20KB
|
456 lines
UNIT Dos4to5;
(*====================================================================*\
|| MODULE NAME: Dos4to5 ||
|| DEPENDENCIES: System.TPU, Dos.TPU, StrUtil.TPU ||
|| LAST MOD ON: 8908.31 ||
|| PROGRAMMER: Naoto Kimura ||
|| ||
|| DESCRIPTION: This is a library of DOS service routines for use ||
|| with version 4.0 of the Turbo pascal compiler. This ||
|| library of routines implements routines available in ||
|| version 5.0 of the Turbo pascal compiler that are ||
|| unavailable in version 4.0. ||
|| ||
|| Modification history ||
|| ||
|| 9006.18 Naoto Kimura ||
|| * Recoded some of the routines in assembler for speed. ||
\*====================================================================*)
{$S+} {Stack checking on}
{$I-} {I/O checking off}
{$N-} {No numeric coprocessor}
INTERFACE
USES
Dos,StrUtil;
(*--------------------------------------------------------------------*\
| NAME: DosVersion |
| |
| This function returns the version of DOS installed on the |
| computer. The low order byte of the word returned contains the |
| major version number, while the high order byte contains the minor |
| version number. |
\*--------------------------------------------------------------------*)
FUNCTION DosVersion : Word;
(*--------------------------------------------------------------------*\
| NAME: GetCBreak |
| |
| This procedure returns the Control-break checking status of DOS. |
\*--------------------------------------------------------------------*)
PROCEDURE GetCBreak (VAR Break : Boolean);
(*--------------------------------------------------------------------*\
| NAME: SetCBreak |
| |
| This procedure sets the Control-break checking status of DOS. |
\*--------------------------------------------------------------------*)
PROCEDURE SetCBreak (Break : Boolean);
(*--------------------------------------------------------------------*\
| NAME: GetVerify |
| |
| This procedure sets the Control-break checking status of DOS. |
\*--------------------------------------------------------------------*)
PROCEDURE GetVerify (var Verify : Boolean);
(*--------------------------------------------------------------------*\
| NAME: SetVerify |
| |
| This procedure sets the Control-break checking status of DOS. |
\*--------------------------------------------------------------------*)
PROCEDURE SetVerify (Verify : Boolean);
TYPE
ComStr = string[127];
PathStr = string[79];
DirStr = string[67];
NameStr = string[8];
ExtStr = string[4];
(*--------------------------------------------------------------------*\
| NAME: FSearch |
| |
| This function is used to search for the specified file in a |
| given set of directories. The Path parameter is formatted in the |
| same manner in which the DOS environment variable PATH is formatted |
| (each entry is separated from the next with a semicolon). |
\*--------------------------------------------------------------------*)
FUNCTION FSearch(
Path : PathStr;
DirList : String
) : PathStr;
(*--------------------------------------------------------------------*\
| NAME: FSplit |
| |
| This procedure splits a fully specified file name, and splits |
| the filename into its components. |
\*--------------------------------------------------------------------*)
PROCEDURE FSplit (
Path : PathStr;
VAR Dir : DirStr;
VAR Name : NameStr;
VAR Ext : ExtStr );
(*--------------------------------------------------------------------*\
| NAME: FExpand |
| |
| This function expands the file name to a fully qualified path |
| file name. |
\*--------------------------------------------------------------------*)
FUNCTION FExpand (
Path : PathStr
) : PathStr;
(*--------------------------------------------------------------------*\
| NAME: GetEnv |
| |
| This routine is patterned after the UNIX operating system call |
| which obtains the value of a specified environment variable. A |
| process will inherit a copy of the parent's environment. Often, the |
| environment variables are used to communicate between processes. |
| Here are some examples of the usage of this function: |
| |
| s := GetEnv('PATH')) -- Sets "s" to the list of |
| directories in which executable |
| programs are to be found. |
| writeln(GetEnv('PROMPT')) -- Prints the value of the DOS |
| command interpreter prompt. |
| s := GetEnv('INITFILE') -- Sets "s" to the value of the |
| environment variable "FOO". |
\*--------------------------------------------------------------------*)
FUNCTION GetEnv( envvar : string ) : string;
(*--------------------------------------------------------------------*\
| NAME: EnvCount |
| |
| This function returns the number of environment strings set in |
| the environment. |
\*--------------------------------------------------------------------*)
FUNCTION EnvCount : integer;
(*--------------------------------------------------------------------*\
| NAME: EnvStr |
| |
| This function returns the Index'th environment string. The |
| string returned by this function is of the form 'VAR=VALUE.' If |
| Index is beyond the last environment, then it will return a null |
| string. |
\*--------------------------------------------------------------------*)
FUNCTION EnvStr( Index : integer ) : string;
IMPLEMENTATION
CONST
DirSeparator = '\';
AltDirSeparator = '/';
DskSeparator = ':';
DirCharSet : CharSet = ['/','\'];
DOSsepChars : CharSet = ['/','\',':'];
TYPE
(*----------------------------------------------------------------*\
| The following record type describes the contents of the Program |
| Segment Prefix (PSP). |
| |
| int20H exit code |
| TopOfMemory Memory size in paragraphs |
| Reserved0 ??? (0) |
| PSP_DOS Far call to DOS |
| TerminationAddr Terminate address |
| BreakExitAddr Address of break handler |
| CriticalErrorAddr Address of critical error handler |
| ParentPSP_Seg Parent PSP segment |
| OpenFiles Open files, $ff = unused |
| EnvironmentSeg Environment segment |
| PSP_OldStack far pointer to processes SS:SP ??? |
| PSP_Nfiles maximum open files |
| PSP_aofile ofile address |
| Reserved3 Unused ??? |
| PSP_int21 INT 21, far return |
| Reserved4 Unused ??? |
| PSP_FCB1ext FCB #1 extension |
| PSP_FCB1 FCB #1 |
| PSP_FCB2ext FCB #2 extension |
| PSP_FCB2 FCB #2 |
| PSP_DMA Command Tail |
| |
\*----------------------------------------------------------------*)
PSPtype = RECORD
int20H : word; {00}
TopOfMemory : word; {02}
Reserved0 : byte; {04}
PSP_DOS : ARRAY [0..4] OF byte; {05}
TerminationAddr, {0A}
BreakExitAddr, {0E}
CriticalErrorAddr : pointer; {12}
ParentPSP_Seg : word; {16}
OpenFiles : ARRAY [0..19] OF byte; {18}
EnvironmentSeg : word; {2C}
PSP_OldStack : pointer; {2E}
PSP_Nfiles : integer; {32}
PSP_aofile : pointer; {34}
Reserved3 : ARRAY [0..23] OF byte; {38}
PSP_int21 : ARRAY [0..1] OF byte; {50}
Reserved4 : ARRAY [0..1] OF byte; {53}
PSP_FCB1ext : ARRAY [0..6] OF byte; {55}
PSP_FCB1 : ARRAY [0..8] OF byte; {5C}
PSP_FCB2ext : ARRAY [0..6] OF byte; {65}
PSP_FCB2 : ARRAY [0..19] OF byte; {6C}
PSP_DMA : ARRAY [0..127] OF byte {80}
END;
{$L Dos4to5.OBJ}
(*--------------------------------------------------------------------*\
| NAME: DosVersion |
\*--------------------------------------------------------------------*)
FUNCTION DosVersion : Word;
External;
(*--------------------------------------------------------------------*\
| NAME: GetCBreak |
\*--------------------------------------------------------------------*)
PROCEDURE GetCBreak (VAR Break : Boolean);
External;
(*--------------------------------------------------------------------*\
| NAME: SetCBreak |
\*--------------------------------------------------------------------*)
PROCEDURE SetCBreak (Break : Boolean);
External;
(*--------------------------------------------------------------------*\
| NAME: GetVerify |
\*--------------------------------------------------------------------*)
PROCEDURE GetVerify (VAR Verify : Boolean);
External;
(*--------------------------------------------------------------------*\
| NAME: SetVerify |
\*--------------------------------------------------------------------*)
PROCEDURE SetVerify (Verify : Boolean);
External;
(*--------------------------------------------------------------------*\
| NAME: FSearch |
\*--------------------------------------------------------------------*)
FUNCTION FSearch(
Path : PathStr;
DirList : String
) : PathStr;
VAR
Found : Boolean;
Tmp : String;
i : Integer;
f : Text;
BEGIN
Found := FALSE;
Assign(f,Path);
{$I-}Reset(f);{$I+}
IF IOresult=0 THEN BEGIN
Found := TRUE;
Close(f);
Tmp := Path
END;
WHILE (DirList <> '') AND NOT FOUND DO BEGIN
i := Pos(';',DirList);
IF i=0 THEN
i := Length(DirList)+1;
Tmp := Copy(DirList,1,i-1);
DirList := Copy(DirList,i+1,Length(DirList)-i);
IF Tmp[Length(Tmp)] IN ['/','\',':'] THEN
Tmp := Tmp+Path
ELSE
Tmp := Tmp+'\'+Path;
Assign(f,Tmp);
{$I-}Reset(f);{$I+}
IF IOresult=0 THEN BEGIN
Found := TRUE;
close(f)
END
END;
IF Found THEN
FSearch := Tmp
ELSE
FSearch := ''
END; (* FSearch *)
(*--------------------------------------------------------------------*\
| NAME: FSplit |
| |
| EXTERNALS: |
| const DirSeparator, AltDirSeparator (local to unit) |
| function RCharSetPos (from StrUtil unit) |
\*--------------------------------------------------------------------*)
PROCEDURE FSplit (
Path : PathStr;
VAR Dir : DirStr;
VAR Name : NameStr;
VAR Ext : ExtStr );
VAR
i,j : integer;
BEGIN
i := RCharSetPos(DOSsepChars,Path);
IF i=0 THEN
Dir := ''
ELSE BEGIN
Dir := Copy(Path,1,i);
Delete(Path,1,i)
END;
j := RPos('.',Path);
IF j=0 THEN BEGIN
Name := Path;
Ext := ''
END
ELSE BEGIN
Name := copy(Path,1,j-1);
Ext := copy(Path,j,length(Path)-j+1)
END
END; (* FSplit *)
(*--------------------------------------------------------------------*\
| NAME: FExpand |
| |
| EXTERNALS: |
| const DirSeparator, AltDirSeparator (local to unit) |
| function RCharSetPos (from StrUtil unit) |
\*--------------------------------------------------------------------*)
FUNCTION FExpand (
Path : PathStr
) : PathStr;
VAR
i,j : integer;
TmpStr,
WorkBuffer : string;
BEGIN
TmpStr := Path;
(* strip off any drivespec and get pwd on drive *)
IF Pos(DskSeparator,TmpStr) <> 2 THEN
GetDir(0,WorkBuffer)
ELSE IF NOT (Path[1] IN Alphabet) THEN
GetDir(0,WorkBuffer)
ELSE BEGIN
GetDir(ord(UpCase(TmpStr[1]))-ord('A')+1, WorkBuffer);
TmpStr := copy(TmpStr,3,length(TmpStr)-2)
END;
(* strip trailing slash on pwd of selected drive *)
IF length(WorkBuffer) > 0 THEN
IF WorkBuffer[length(WorkBuffer)] IN DirCharSet THEN
Dec(WorkBuffer[0]);
(* handle reference to root *)
IF TmpStr[1] IN DirCharSet THEN BEGIN
WorkBuffer[0] := #2;
WHILE (length(TmpStr)>0) AND (TmpStr[1] IN DirCharSet) DO
TmpStr := copy(TmpStr,2,length(TmpStr)-1)
END;
(* Strip relative refereces *)
i := CharSetPos(DirCharSet,TmpStr);
WHILE i <> 0 DO BEGIN
IF copy(TmpStr,1,i-1)='.' THEN
TmpStr := copy(TmpStr,3,length(TmpStr)-2)
ELSE IF copy(TmpStr,1,i-1)='..' THEN BEGIN
TmpStr := copy(TmpStr,4,length(TmpStr)-2);
j := RCharSetPos(DirCharSet,WorkBuffer);
IF j>0 THEN
Dec(WorkBuffer[0],length(WorkBuffer)-j+1)
END
ELSE BEGIN
WorkBuffer := WorkBuffer + DirSeparator
+ copy(TmpStr,1,i-1);
TmpStr := copy(TmpStr,i+1,length(TmpStr)-i)
END;
i := CharSetPos(DirCharSet,TmpStr)
END;
IF TmpStr = '.' THEN
FExpand := WorkBuffer
ELSE IF TmpStr <> '..' THEN
FExpand := WorkBuffer + DirSeparator + TmpStr
ELSE BEGIN
j := RCharSetPos(DirCharSet,WorkBuffer);
IF j = 0 THEN
FExpand := WorkBuffer + DirSeparator
ELSE BEGIN
IF j > 3 THEN
Dec(WorkBuffer[0],length(WorkBuffer)-j+1)
ELSE
Dec(WorkBuffer[0],length(WorkBUffer)-j);
FExpand := WorkBuffer
END
END
END; (* FExpand *)
CONST
EnvironmentSeg : word = 0;
(*--------------------------------------------------------------------*\
| NAME: GetEnv |
| |
| EXTERNALS: |
| word EnvironmentSeg (local to unit) |
\*--------------------------------------------------------------------*)
FUNCTION GetEnv( envvar : string ) : string;
VAR
i : integer;
found : boolean;
WorkBuffer : string;
BEGIN (* GetEnv *)
i := 0;
found := false;
WHILE NOT (found OR (mem[EnvironmentSeg:i]=0)) DO BEGIN
WorkBuffer := '';
WHILE mem[EnvironmentSeg:i] <> ord('=') DO BEGIN
WorkBuffer := WorkBuffer + chr(mem[EnvironmentSeg:i]);
Inc(i)
END;
Inc(i); (* skip '=' *)
found := WorkBuffer = envvar;
WorkBuffer := '';
WHILE mem[EnvironmentSeg:i] <> 0 DO BEGIN
WorkBuffer := WorkBuffer + chr(mem[EnvironmentSeg:i]);
Inc(i)
END;
Inc(i) (* skip '\0' *)
END;
IF found THEN
GetEnv := WorkBuffer
ELSE
GetEnv := ''
END; (* GetEnv *)
(*--------------------------------------------------------------------*\
| NAME: EnvCount |
| |
| EXTERNALS: |
| word EnvironmentSeg (local to unit) |
\*--------------------------------------------------------------------*)
FUNCTION EnvCount : integer;
External;
(*--------------------------------------------------------------------*\
| NAME: EnvStr |
| |
| EXTERNALS: |
| word EnvironmentSeg (local to unit) |
\*--------------------------------------------------------------------*)
FUNCTION EnvStr( Index : integer ) : string;
External;
(*====================================================================*\
|| Dos4to5 unit initialization code ||
||--------------------------------------------------------------------||
|| EXTERNALS: ||
|| function PrefixSeg ||
|| type PSPtype ||
\*====================================================================*)
BEGIN
EnvironmentSeg := PSPtype(ptr(PrefixSeg,$0)^).EnvironmentSeg
END.
